home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MPW Oberon 2.1168 / OInterfaces / Runtime.a < prev    next >
Encoding:
Text File  |  1995-07-27  |  7.2 KB  |  475 lines  |  [TEXT/MPS ]
  1.         MACHINE    MC68040     ; Move16
  2.         CASE    OBJECT
  3.  
  4. *        INCLUDE    'Traps.a'
  5.         INCLUDE    'Errors.a'
  6.         INCLUDE    'Types.a'
  7.         INCLUDE    'Memory.a'
  8.         INCLUDE    'Resources.a'
  9.         INCLUDE    'SegLoad.a'
  10.  
  11. test_Globals    RECORD    ,DECR
  12.         EXPORT    %FP0,%FP1,%FP2,%FP3,%FP4,%FP5,%FP6,%FP7
  13. %FP0        DS.B    10
  14. %FP1        DS.B    10
  15. %FP2        DS.B    10
  16. %FP3        DS.B    10
  17. %FP4        DS.B    10
  18. %FP5        DS.B    10
  19. %FP6        DS.B    10
  20. %FP7        DS.B    10
  21.         ENDR    
  22.  
  23. %MyBlockMove     PROC      EXPORT
  24.         Move.L    D0,D3
  25.         Move.L    A0,D1
  26.         And.W    #15,D1
  27.         Move.L    A1,D2
  28.         And.W    #15,D2
  29.         Cmp.W    D1,D2
  30.         Bne    @doTrap        ; Move16 can't be applied
  31.  
  32.         Tst.W    D1        ; address aligned to multiple of 16?
  33.         Beq.s    @1        ; yes => jump
  34.  
  35.         Moveq    #16,D0        ; move bytes 'til next multiple of 16
  36.         Sub.W    D1,D0
  37.         Sub.L    D0,D3
  38.         Bsr.S    @copy0_15
  39.  
  40. @1        Move.L    D3,D0        ; compute number of Move16s
  41.         And.L    #15,D0
  42.         Lsr.L    #4,D3        ; D3:=D3 DIV 16
  43.         Bra.S    @decr
  44.  
  45. @loop        Move16     (A0)+,(A1)+
  46. @decr        DBra    D3,@loop
  47.  
  48.         ; move remaining bytes
  49. @copy0_15    Move.L    D0,D1
  50.         Add.L    D0,D0
  51.         Lsl.L    #3,D1
  52.         Add.L    D0,D1
  53.         Jmp    (@copy0,D1)
  54. @copy0        Rts
  55.         NOP
  56.         NOP
  57.         NOP
  58.         NOP
  59. @copy1        Move.B    (A0)+,(A1)+
  60.         Rts
  61.         NOP
  62.         NOP
  63.         NOP
  64. @copy2        Move.W    (A0)+,(A1)+
  65.         Rts
  66.         NOP
  67.         NOP
  68.         NOP
  69. @copy3        Move.B    (A0)+,(A1)+
  70.         Move.W    (A0)+,(A1)+
  71.         Rts
  72.         NOP
  73.         NOP
  74. @copy4        Move.L    (A0)+,(A1)+
  75.         Rts
  76.         NOP
  77.         NOP
  78.         NOP
  79. @copy5        Move.B    (A0)+,(A1)+
  80.         Move.L    (A0)+,(A1)+
  81.         Rts
  82.         NOP
  83.         NOP
  84. @copy6        Move.W    (A0)+,(A1)+
  85.         Move.L    (A0)+,(A1)+
  86.         Rts
  87.         NOP
  88.         NOP
  89. @copy7        Move.B    (A0)+,(A1)+
  90.         Move.W    (A0)+,(A1)+
  91.         Move.L    (A0)+,(A1)+
  92.         Rts
  93.         NOP
  94. @copy8        Move.L    (A0)+,(A1)+
  95.         Move.L    (A0)+,(A1)+
  96.         Rts
  97.         NOP
  98.         NOP
  99. @copy9        Move.B    (A0)+,(A1)+
  100.         Move.L    (A0)+,(A1)+
  101.         Move.L    (A0)+,(A1)+
  102.         Rts
  103.         NOP
  104. @copy10        Move.W    (A0)+,(A1)+
  105.         Move.L    (A0)+,(A1)+
  106.         Move.L    (A0)+,(A1)+
  107.         Rts
  108.         NOP
  109. @copy11        Move.B    (A0)+,(A1)+
  110.         Move.W    (A0)+,(A1)+
  111.         Move.L    (A0)+,(A1)+
  112.         Move.L    (A0)+,(A1)+
  113.         Rts
  114. @copy12        Move.L    (A0)+,(A1)+
  115.         Move.L    (A0)+,(A1)+
  116.         Move.L    (A0)+,(A1)+
  117.         Rts
  118.         NOP
  119. @copy13        Move.B    (A0)+,(A1)+
  120.         Move.L    (A0)+,(A1)+
  121.         Move.L    (A0)+,(A1)+
  122.         Move.L    (A0)+,(A1)+
  123.         Rts
  124. @copy14        Move.W    (A0)+,(A1)+
  125.         Move.L    (A0)+,(A1)+
  126.         Move.L    (A0)+,(A1)+
  127.         Move.L    (A0)+,(A1)+
  128.         Rts
  129. @copy15        Move.B    (A0)+,(A1)+
  130.         Move.W    (A0)+,(A1)+
  131.         Move.L    (A0)+,(A1)+
  132.         Move.L    (A0)+,(A1)+
  133.         Move.L    (A0)+,(A1)+
  134.         Rts
  135.  
  136. @doTrap        _Blockmove
  137.         Rts
  138.         ENDPROC
  139.         
  140. %saveFReg     PROC    EXPORT
  141.         Move.L    (A7)+,A0
  142.         Move.L    (A7)+,D1
  143.         Clr.L    D0
  144.         Bra.S    end1         
  145.  
  146. loop1        BTst    D0,D1
  147.         Beq.S    go1
  148.  
  149.         Move.L    D0,D2
  150.         Muls.W    #10,D2
  151.         Lea    (%FP0,A5,D2),A1
  152.         Move.L    (A1)+,-(A7)
  153.         Move.L    (A1)+,-(A7)
  154.         Move.W    (A1)+,-(A7)
  155.  
  156. go1        Addq.W    #$1,D0
  157.  
  158. end1        Cmp.W    #7,D0
  159.         Ble.S    loop1 
  160.         Jmp    (A0)
  161.         DC.B    $80,'%saveFReg'
  162.         ALIGN
  163.         DC.W    0
  164.         ENDP
  165.         
  166. %restFReg       PROC    EXPORT
  167.         Move.L    (A7)+,A0
  168.         Move.L    (A7)+,D1
  169.         Moveq    #7,D0
  170.         Bra.S    end1          
  171.  
  172. loop1            BTst     D0,D1
  173.         Beq.S    go1
  174.  
  175.         Move.L    D0,D2
  176.         Addq    #1,D2
  177.         Muls.W    #10,D2
  178.         Lea    (%FP0,A5,D2),A1
  179.         Move.W    (A7)+,-(A1)
  180.         Move.L    (A7)+,-(A1)
  181.         Move.L    (A7)+,-(A1)
  182.  
  183. go1        Subq    #$1,D0
  184.  
  185. end1        Tst    D0
  186.         Bge.S    loop1  
  187.         Jmp    (A0)
  188.         DC.B    $80,'%restFReg'
  189.         ALIGN
  190.         DC.W    0
  191.         ENDP
  192.  
  193. Runtime_RangeError    PROC    EXPORT
  194.         LINK    A6,#0
  195.         PEA    @message
  196.         _DebugStr
  197.         _ExitToShell
  198.         UNLK    A6
  199.         RTD    #8
  200.         DC.B    $80,'Runtime_RangeError'
  201.         ALIGN
  202.         DC    @end-@message
  203. @message    DC.B    'Invalid index'
  204.         ALIGN
  205. @end
  206.         ENDP
  207.  
  208. Runtime_ConversionError    PROC    EXPORT
  209.         LINK    A6,#0
  210.         PEA    @message
  211.         _DebugStr
  212.         _ExitToShell
  213.         UNLK    A6
  214.         Rts
  215.         DC.B    $80,'Runtime_ConversionError'
  216.         ALIGN
  217.         DC    @end-@message
  218. @message    DC.B    'Value too large for SHORTINT'
  219.         ALIGN
  220. @end
  221.         ENDP
  222.  
  223. Runtime_NoReturn    PROC    EXPORT
  224.         LINK    A6,#0
  225.         PEA    @message
  226.         _DebugStr
  227.         _ExitToShell
  228.         UNLK    A6
  229.         Rts
  230.         DC.B    $80,'Runtime_NoReturn'
  231.         ALIGN
  232.         DC    @end-@message
  233. @message    DC.B    'Function procedure without RETURN statement'
  234.         ALIGN
  235. @end
  236.         ENDP
  237.  
  238. Runtime_TypeGuardFailure    PROC    EXPORT
  239.         LINK    A6,#0
  240.         PEA    @message
  241.         _DebugStr
  242.         _ExitToShell
  243.         UNLK    A6
  244.         Rts
  245.         DC.B    $80,'Runtime_TypeGuardFailure'
  246.         ALIGN
  247.         DC    @end-@message
  248. @message    DC.B    'Type guard check failed'
  249.         ALIGN
  250. @end
  251.         ENDP
  252.         
  253. Runtime_AssertFailure    PROC    EXPORT
  254.         LINK    A6,#0
  255.         PEA    @message
  256.         _DebugStr
  257.         _ExitToShell
  258.         UNLK    A6
  259.         Rts
  260.         DC.B    $80,'Runtime_AssertFailure'
  261.         ALIGN
  262.         DC    @end-@message
  263. @message    DC.B    'Assertion failed'
  264.         ALIGN
  265. @end
  266.         ENDP
  267.  
  268.  
  269. Runtime_CaseError    PROC    EXPORT
  270.         LINK    A6,#-256
  271.         LEA    errString+2,A1
  272.         MOVE.B    (A1),D0
  273.         EXT.W    D0
  274.         LEA    -256(a6),A0
  275. loop        MOVE.B    (A1)+,(A0)+
  276.         DBF    D0,loop
  277.         MOVE.B    ([8,a6]),D1
  278.         ADD.B    D1,-256(a6)
  279.         EXT.W    D1
  280.         LEA    ([8,a6],1),A1
  281. loop2        MOVE.B    (A1)+,(A0)+
  282.         DBF    D1,loop2
  283.         MOVE.B    -256(a6),D0
  284.         EXT.W    D0
  285.         MOVE.W    D0,-(a7)
  286.         PEA    -256(a6)
  287.         _DebugStr
  288.         _ExitToShell
  289.         UNLK    A6
  290.         Rts
  291.         DC.B    $80,'Runtime_CaseError'
  292.         ALIGN
  293. errString
  294.         DC    @end-@message
  295.  
  296. @message    DC.B    'Invalid case in CASE statement. Selector: '
  297.         ALIGN
  298. @end
  299.         ENDP
  300.  
  301. Runtime_AllocateTagged    PROC    EXPORT
  302.         MOVE.L     ([4,A7]),D0
  303.         ADDQ.L    #4,D0
  304.         _NewPtr
  305.         BNE.S    @return
  306.         MOVE.L    4(A7),(A0)+
  307. @return        MOVE.L    A0,([8,A7])
  308.         RTD    #8
  309.         DC.B    $80,'Runtime_AllocateTagged'
  310.         ALIGN
  311.         DC    0
  312.         ENDP
  313.  
  314. Runtime_AllocateUntagged    PROC    EXPORT
  315.         MOVE.L    4(A7),D0
  316.         _NewPtr
  317.         MOVE.L    A0,([8,A7])
  318.         RTD    #8
  319.         DC.B    $80,'Runtime_AllocateUntagged'
  320.         ALIGN
  321.         DC    0
  322.         ENDP
  323.  
  324. IE_GETENV    PROC    EXPORT        
  325.  
  326.         IMPORT     (getenv):CODE
  327.  
  328.         Move.L    8(A7),-(A7)
  329.         Jsr    getenv
  330.         Addq.L    #4,A7
  331.         Tst.L    D0
  332.         Beq.S    @return
  333.  
  334.         Move.L    4(A7),A1
  335.         Move.L    D0,A0
  336.         Move    #255,D0
  337.  
  338. @loop        Move.B    (A0)+,(A1)+
  339.         DBeq    D0,@loop
  340.  
  341.         Clr.B    -(A1)
  342.         Moveq    #1,D0
  343.  
  344. @return        Move.B    D0,12(A7)    ; Pascal-Funktion: Returnvalue on Stack
  345.         Rtd    #8
  346.         ENDP
  347.  
  348. InitEnvironment    PROC    EXPORT
  349.  
  350.         IMPORT    (__setjmp,_RTInit,InitTags):CODE
  351.         IMPORT    (IntEnv_ArgC,IntEnv_ArgV,IntEnv__EnvP):DATA
  352.         IMPORT    (_ArgC,_ArgV,_EnvP,__MyEnv):DATA
  353.  
  354.         CLR.L    -(A7)        ;pass C-strings
  355.         PEA    _EnvP
  356.         PEA    _ArgV
  357.         PEA    _ArgC
  358.         MOVE.L     $14(A7),-(A7)
  359.         JSR    _RTInit
  360.         Move.L    _EnvP,IntEnv__EnvP
  361.         Move.L    _ArgV,IntEnv_ArgV
  362.         Move.L    _ArgC,IntEnv_ArgC
  363.  
  364.         LEA    $14(A7),A7
  365.         PEA    __MyEnv
  366.         JSR    __setjmp
  367.         ADDQ.L    #4,A7
  368.         TST.L    D0
  369.         BNE.S    @return
  370.         JSR    InitTags
  371.         MOVEQ    #0,D0
  372.         Rts
  373.  
  374. @error        PEA    @message
  375.         MOVE    #$FE15,D0
  376.         _SysError
  377.  
  378. @return        ADDQ.L     #$4,A7
  379.         Rts
  380.  
  381. @message    DC.B    'Data initialization failed!'
  382.         ENDP
  383.  
  384.         SEG    '%OberonTags'
  385. InitTags    PROC    EXPORT
  386.         MOVEM.L    A2/A3,-(A7)
  387.         CLR.L    -(A7)
  388.         MOVE.L    #'CODE',-(A7)
  389.         PEA    @segmentName
  390.         _GetNamedResource
  391.         MOVEA.L (A7)+,A2
  392.         MOVE.L    (A2),D0
  393.         DC.W    $A055            ;_StripAddress
  394.         MOVEA.L    D0,A0
  395.         ADDQ    #4,A0
  396.         MOVE.L    A0,D2
  397.         SUB.L    baseAddress,D2
  398.         TST.L    baseAddress
  399.         BNE.S    @adjust
  400.  
  401.         LEA    ConvertTags,A3
  402.         BRA.S    @doIt
  403.  
  404. @adjust        LEA    AdjustTags,A3
  405.  
  406. @doIt        LEA    baseAddress,A1
  407.         MOVE.L    A0,(A1)
  408.         LEA    InitTags,A1
  409.         JSR    (A3)
  410.  
  411.         MOVEA.L    A2,A0
  412.         _GetHandleSize
  413.         ADD.L    (A2),D0
  414.         DC.W    $A055            ;_StripAddress
  415.         MOVEA.L    D0,A1
  416.         LEA    EndOfModule,A0
  417.         JSR    (A3)
  418.  
  419. @return        MOVEM.L    (A7)+,A2/A3
  420.         Rts
  421.         DC.B    $80,'InitTags'
  422.         DC.W    ConvertTags-@segmentName
  423. @segmentName    DC.B    '%OberonTags'
  424. baseAddress    DC.L    0
  425.  
  426. ConvertTags    Cmp.L    A0,A1
  427.         Beq.S    @return
  428.  
  429. @skip        Cmp.W    #$4EED,(A0)    ; skip type-bound procedures
  430.         Bne.S    @begin
  431.         Addq.L    #4,A0
  432.         Bra.S    @skip
  433.  
  434.  
  435. @begin        Addq.L    #4,A0        ; skip record’s size
  436.         Move.L    (A0)+,D0    ; get number of pointers
  437.  
  438. @convert    Move    2(A0),D1
  439.         Ext.L    D1
  440.         Add.L    A0,D1
  441.         Addq.L    #2,D1
  442.         Move.L    D1,(A0)+
  443.  
  444. @check        DBra    D0,@convert
  445.         Bra.S    ConvertTags
  446.  
  447. @return        Rts
  448.         DC.B    $80,'ConvertTags'
  449.         ALIGN
  450.         DC.W    0
  451.  
  452. AdjustTags    Cmp.L    A0,A1
  453.         Beq.S    @return
  454.                     
  455. @skip        Cmp.W    #$4EED,(A0)    ; skip type.bound procedures
  456.         Bne.S    @begin
  457.         Addq.L    #4,A0
  458.         Bra.S    @skip            
  459.                     
  460. @begin        Addq.L    #4,A0        ; skip record’s size
  461.         Move.L    (A0)+,D0
  462.  
  463. @convert    Add.L    D2,(A0)+
  464.  
  465. @check        DBra    D0,@convert
  466.         Bra.S    AdjustTags
  467.  
  468. @return        Rts
  469.         DC.B    $80,'AdjustTags'
  470.         ALIGN
  471.         DC.W    0
  472. EndOfModule
  473.         ENDP
  474.  
  475.         END